IIS + Delphi

Otázka od: Jan Netrval

4. 5. 2004 12:09

Mam takovy problemek. Nezkousel jste nekdo z Delphi vytvaret a editovat objekty
v IIS (napr. VirtualDirectory).

 

Pouzivam neco takoveho:

 

obj := ADsHlp.GetObject('IIS://localhost/w3svc/1/root/xxx);
 
A po provedeni tohoto radku at udelam co udelam, tak program spadne.
Ing. Jan Netrval
PilsCom, s.r.o. www.pilscom.cz
Houskova 16
326 00 Plzen (Pilsen) Czech Republic
Tel.: +420 377 441 306
GSM: +420 603 851 391
E-mail: jnetrval@pilscom.cz
 


Odpovedá: Jan Netrval

5. 5. 2004 6:54

Jeste bych upresnil, ze se jedna o IIS 5.0. Opravdu nevim co s tim.

Ing. Jan Netrval
PilsCom, s.r.o. www.pilscom.cz
Houskova 16
326 00 Plzen (Pilsen) Czech Republic
Tel.: +420 377 441 306
GSM: +420 603 851 391
E-mail: jnetrval@pilscom.cz


> -----Original Message-----
> From: Jan Netrval
> Sent: Tuesday, May 04, 2004 12:53 PM
> To: delphi-l@clexpert.cz
> Subject: IIS + Delphi
>
> Mam takovy problemek. Nezkousel jste nekdo z Delphi vytvaret a editovat
> objekty v IIS (napr. VirtualDirectory).
>
>
>
> Pouzivam neco takoveho:
>
>
>
> obj := ADsHlp.GetObject('IIS://localhost/w3svc/1/root/xxx);
>
>
>
> A po provedeni tohoto radku at udelam co udelam, tak program spadne.
>
> Ing. Jan Netrval
> PilsCom, s.r.o. www.pilscom.cz
> Houskova 16
> 326 00 Plzen (Pilsen) Czech Republic
> Tel.: +420 377 441 306
> GSM: +420 603 851 391
> E-mail: jnetrval@pilscom.cz
>
>
>
>


Odpovedá: Ales Vasicek

5. 5. 2004 7:32

Ahoj,

posilam kus kodu pro vytvoreni virtualniho web serveru, ktery jsem kdysi pouzil
v instalatoru aplikace. Fungovalo to dobre (W2K, IIS 5.0):


(je nutne naimportovat knihovnu activeds.dll!)

//////////////////////
uses activeds_tlb;

.....
.....

function CreateVirtualWebServer : Boolean;
var
  I: IADsContainer;
  ADs: IADs;
  WebSite, webroot, WebServer : Variant;
  AccessFlgs : Integer;
  GlobHandle : THandle;
begin
  Result := True;

  GlobHandle := LoadLibrary('activeds.dll');
  try
  if (GlobHandle <> 0)
  then begin
         @AdsGetObject := GetProcAddress(GlobHandle, 'ADsGetObject');

         try
           if ADsGetObject('IIS://localhost/w3svc', IID_IADsContainer,
IUnknown(I)) = S_Ok
           then begin
                  ADs := IADs (I.GetObject ('IIsWebServer',
IntToStr(FVirtualWeb.ParentServerID)));
                  If ADs.QueryInterface (IID_IADsContainer, I) = S_OK
                  then begin
                         ADs := IADs (I.GetObject ('IIsWebVirtualDir',
'Root'));
                         If ADs.QueryInterface (IID_IADsContainer, I) = S_OK
                         then begin
                                aDs := IADs (I.Create ('IIsWebVirtualDir',
FVirtualWeb.ServerName));
                                ADs.Put('Path', GetPath(FVirtualWeb.RootPath));
                                ADs.SetInfo;
                              end;

                         //////////////////////////////////////////
                         WebSite := CreateOleObject('IISNamespace');
                         WebSite := WebSite.GetObject('IIsWebService',
'localhost/w3svc');
                         WebServer := WebSite.GetObject('IIsWebServer', '1');
                         WebRoot := WebServer.GetObject('IIsWebVirtualDir',
'Root\' + FVirtualWeb.ServerName);
                         webroot.AppCreate(True);

                         case FVirtualWeb.IsolatedLevel
                         of 0 : WebRoot.AppIsolated := 0;
                            1 : WebRoot.AppIsolated := 2;
                            2 : WebRoot.AppIsolated := 1;
                         end;
                         /// 0 - LOW (IIS process)
                         /// 2 - MEDIUM (Pooled)
                         /// 1 - HIGH (Isolated)

                         WebRoot.AppFriendlyName :=
FVirtualWeb.AppFriendlyName;

                         AccessFlgs := 0;
                         if FVirtualWeb.AccessRead
                         then AccessFlgs := AccessFlgs or $1;
                         if FVirtualWeb.AccessWrite
                         then AccessFlgs := AccessFlgs or $2;
                         if FVirtualWeb.AccessSource
                         then AccessFlgs := AccessFlgs or $10;

                         case FVirtualWeb.ExecutePermissions
                         of 1 : AccessFlgs := AccessFlgs or $200; // <--
SCRIPTS ONLY
                            2 : AccessFlgs := AccessFlgs or $4; // <--
SCRIPTS AND EXECUTABLES
                         end;

                         WebRoot.AccessFlags := AccessFlgs;
                         WebRoot.EnableDirBrowsing :=
FVirtualWeb.DirectoryBrowsing;
                         Webroot.SetInfo;

                         I := nil;
                         Ads := nil;
                       end;
                end;
         except
           on E : Exception
           do begin
                if MessageDlg(Format(GetStr('main_create_virt_server_err'),
[E.Message]), mtError, [mbYes, mbNo], 0) = mrNo
                then Result := False;
              end;
         end;
       end
  else begin
         MessageDlg(GetStr('main_loading_activeds_dll_err'), mtError, [mbOK],
0);
       end;
  finally
    FreeLibrary(GlobHandle);
  end;
end;

Ales

> -----Original Message-----
> From: Jan Netrval [mailto:jnetrval@pilscom.cz]
>
> Jeste bych upresnil, ze se jedna o IIS 5.0. Opravdu nevim co s tim.
>
> Ing. Jan Netrval